#|_____________________________________________________
 |
 | display2.lsp
 | Copyright (c) 1999-2000 by Forrest W. Young
 | Specialized uses of the window for displaying text.
 | Code for help, plot-help, info and interpret windows 
 |_____________________________________________________
 |#


(setf *help-window* nil)

(defun print-text (&optional text)
  (when text (send *current-text-window* :print-text "ViSta Printout")))


(defmeth display-window-proto2 :print-text (&key (print-size '(650 900)) (num-buffer-lines 50))
  (let* ((filename (strcat *default-path* "print.txt"))
         (helper.exe *printer.exe*)
         (name.exe "WORDPAD.EXE")
         (command-string (strcat " -p " filename))
         (header (send self :printout-header))
         (text (send self :strings))
         (all (push header text))
         (file)
         )
    (send self :write-text-to-file all filename)
    (setf file (open filename))
    (when (not (system (strcat helper.exe command-string)))
          (setf helper.exe (strcat "\"" *prgfil-path* "Accessories\\wordpad.exe\""))
          (when (not (system (strcat helper.exe command-string)))
                (one-button-dialog (strcat "Please Use the next Dialog to Locate " 
                                           (string-upcase name.exe)))
                (set-working-directory *prgfil-path*)
                (setf helper.exe (open-file-dialog helper.exe ".exe"))
                (system (strcat helper.exe  command-string))))
    (setf *printer.exe* helper.exe)
    helper.exe))


(defmeth display-window-proto2 :print-text 
  (&key (print-size '(650 900)) (num-buffer-lines 50))
  (let* ((filename (strcat *default-path* "print.txt"))
         (command-string (strcat " /p " filename))
         (header (send self :printout-header))
         (text (send self :strings))
         (notepad.exe "notepad.exe")
         (all (push header text))
         (file)
         )

    (send self :write-text-to-file all filename)
    (setf file (open filename))
    (when (not (system (strcat *printer.exe* command-string)))
          (when (not (system (strcat notepad.exe command-string)))
                (one-button-dialog (strcat "Please Use the next Dialog to Locate " 
                                           (string-upcase notepad.exe)))
                (set-working-directory *prgfil-path*)
                (setf notepad.exe (open-file-dialog notepad.exe ".exe"))
                (system (strcat notepad.exe  command-string))
                (setf *printer.exe* notepad.exe))
	(setf *printer.exe* notepad.exe))
    *printer.exe*))

(defmeth display-window-proto2 :printout-header ()
  (format nil
    "ViSta - The Visual Statistics System~%~a, ~a - ~a~2%~a~3%"
    (select (date-time) 2) (select (date-time) 0) (select (date-time) 1) 
          (send self :title)))

(defmeth display-window-proto2 :make-menu (&optional text-menu (reusable t))
  (let* ((text-menu (if text-menu text-menu
                        (send menu-proto :new "Text")))
         (print-text-menu-item
          (send menu-item-proto :new "&Print Text ..." 
                :action #'(lambda () (send self :print-text))))
         (save-text-menu-item
          (send menu-item-proto :new "Save Text ..." :enabled t
                :action '(lambda () (save-text :dialog t))))
         (text-to-listener-menu-item
          (send menu-item-proto :new "Write Listener" :enabled t
                :action 'write-listener))
         (fit-text-menu-item (send menu-item-proto :new "AutoResize" 
                                   :mark (send *vista* :fit-window-to-text?)))
         (click-close-menu-item (send menu-item-proto :new "Click to Close"
                                      :mark (send *vista* :click-to-close)))
         (top-most-menu-item (send menu-item-proto :new "Always on Top"
                                   :mark (send *vista* :always-on-top)))
         (reusable-menu-item (if reusable
                                 (send menu-item-proto :new "Reusable"
                                       :mark (send *vista* :reuse-help-windows))))
         (text-window self)
         )
    (send self :top-most-menu-item top-most-menu-item)
    (setf *click-close-menu-item* click-close-menu-item)
    (defmeth fit-text-menu-item :do-action ()
      (send self :mark (not (send self :mark)))
      (when (send *vista* :fit-window-to-text?
                  (fit-window-to-text)))
    ;  (when (not (send *vista* :fit-window-to-text?)) ;fwyfwyfwy
    ;        (defmeth *help-window* :resize ()))
      (send *vista* :fit-window-to-text? (send self :mark)))

    (defmeth top-most-menu-item :do-action ()
      (send self :mark (not (send self :mark)))
      (send text-window :top-most (send self :mark))
      (setf *help-window-top-most?* (send self :mark))
      (send *vista* :always-on-top (send self :mark)))

    (defmeth click-close-menu-item :do-action ()
      (send self :mark (not (send self :mark)))
      (send *vista* :click-to-close (send self :mark)))

    (when reusable
          (defmeth reusable-menu-item :do-action ()
            (send self :mark (not (send self :mark)))
            (send *vista* :reuse-help-windows (send self :mark))))
    
    (send self :menu text-menu)
    (send text-menu :append-items
          print-text-menu-item
          save-text-menu-item
          text-to-listener-menu-item
          (send dash-item-proto :new)
          top-most-menu-item
          fit-text-menu-item ;fwyfwyfwy
          click-close-menu-item
         )
    
    (when reusable
          (send text-menu :append-items
                reusable-menu-item))

    (defmeth self :install ()
      (setf *current-text-window* text-window)
      (call-next-method)
      )
    ;(send self :install)
    ;(send self :remove)
    text-menu))

(defun write-listener ()
  (save-text :dialog nil :listener t))

(defun save-text (&key (dialog t) (listener nil) (file nil))
  (when (and listener file) 
        (error-message "Cant save text to listener and file simultaneously."))
  (if listener 
      (send *current-text-window* :save-text nil listener)
      (send *current-text-window* :save-text file nil)))

  

(defmeth display-window-proto2 :save-text (&optional file listener )
"Args: (&optional file listener)
FILE is a string. The text is written to the file FILE.txt as plain unformatted text. When LISTENER is T, writes to listener."
  (let* ((name (send self :title))
         (L (min 8 (length name)))
         (suggest (strcat (subseq name 0 L) ".txt"))
         (strings (send self :strings))
         (num-strings (length strings)))
    (cond 
      (listener
       (dotimes (i num-strings)
                (format t "~a" (select strings i)))
       t)
      (t
       (if (not (set-working-directory *user-dir-name*))
           (set-working-directory "C:\\windows\\desktop"))
       (when (not file) 
             (setf file 
                   #-X11       (set-file-dialog  "Save Text In File:" suggest)
                   #+X11       (file-save-dialog "Save Text In File:" "*.txt" ".")
                   ))
       (when file (send self :write-text-to-file strings file))
       ))))

(defmeth display-window-proto2 :write-text-to-file (text file &optional quiet)
  (setf file (string-downcase-if-not-X11 file))
  (let ((f (open (string file) :direction :output))
        (num-strings (length text))
        (oldbreak *breakenable*))
    (setq *breakenable* nil)
    (unwind-protect 
     (dotimes (i num-strings)
              (format f "~a" (select text i)))
     )
    (setq *breakenable* oldbreak)
    (close f)
    (unless quiet (format t "; finished saving ~s~%" file))
    f))

      

(defun display-text ()
  (let* ((filename (file-dialog))
         (w (send *vista* :create-help-window :title filename :nowrap t :noformat t
                  :location '(100 100) :size '(475 280) :show nil))
         (width (* 80 (send w :text-width "W")))
         )
    (send w :size width 280)
    (with-open-file 
     (g filename)
     (send *vista* :update-help-window w g filename nil nil)
     (if (> (* (+ 2 (send w :nlines)) (send w :line-height))
            (second (send w :size)))
         (send w :has-v-scroll (* (+ 2 (send w :nlines)) 
                                  (send w :line-height)))
         (send w :has-v-scroll nil))
     (send w :has-h-scroll t)
     (send w :show-window)
     (setf *current-text-window* w))
   t))

; INTERPRETATION WINDOW CODE

;(defun interpretation-window (title &key (flush t))
;  (plot-help-window (strcat "Interpretation for " title) :flush flush))

(defun paste-interpretation (interp &optional ignored)
  (let ((w (send *vista* :help-window-object)))
    (send w :paste-string interp)
    w)) 

;(defun show-interpretation () (show-plot-help))

(defun interpretation-window (title &key (flush t))
  (when (not *about-window*)
        (if *help-window* 
            (setf *about-window* *help-window*)
            (setf *about-window* (initial-help-window))))
  (send *about-window* :title (strcat "Interpretation for " title))
  (when flush (send *about-window* :flush-window))
  )
  
(defun show-interpretation () 
  (send *about-window* :show-window)
  (send *about-window* :resize))


;; INFORMATION WINDOW CODE (used by watcher)

(defun info-window (text &key (title "Info Window") 
                         (size '(100 30)) ;(location '(0 0))
                         (location (send *datasheet* :location))
                        	(show t))
  (let* ((w (send display-window-proto2 :new 
                 :show show :size size :location location :title title))
         )
    (send w :paste-string text :newlines nil)
    w))

(defmeth display-window-proto2 :show-message 
     (&optional (text "This window displays information messages.")
                (title "Message Window") beep)
  (send self :flush-window)
  (send self :scroll 0 0)
  (send self :title title)
  (send self :paste-string text)
  #+macintosh (when (not (equal (front-window) self))
                    (send self :show-window))
  #+containers (send self :pop-out t)
  #-macintosh (send self :show-window)
    (if (> (* (+ 2 (send self :nlines)) 
              (send self :line-height))
           (second (send self :size)))
       (send self :has-v-scroll 
             (* (+ 2 (send self :nlines)) 
                (send self :line-height)))
       (send self :has-v-scroll nil))
  (send self :redraw)
  (if beep (sysbeep))
  )

(defmeth display-window-proto2 :write-text (text &key (show t) (newlines t))
   (send self :flush-window)
   (send self :paste-string text :newlines newlines)
   (when show (send self :show-window))
   (send self :redraw))
